home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / PREVIEW / DLMAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1995-11-12  |  5KB  |  203 lines

  1. unit Dlmain;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Menus, wPreview, wSelPrn, Misc;
  8.  
  9. type
  10.   Tmainwin = class(TForm)
  11.     MainMenu1: TMainMenu;
  12.     File1: TMenuItem;
  13.     Exit1: TMenuItem;
  14.     ActiveWindows1: TMenuItem;
  15.     Normal1: TMenuItem;
  16.     Cascade1: TMenuItem;
  17.     Tile1: TMenuItem;
  18.     Samples1: TMenuItem;
  19.     PlainText1: TMenuItem;
  20.     N2: TMenuItem;
  21.     SelectPrinter1: TMenuItem;
  22.     PreviewJobCost1: TMenuItem;
  23.     ViewBluePrint1: TMenuItem;
  24.     PrintBluePrint1: TMenuItem;
  25.     PreviewJobDueShip1: TMenuItem;
  26.     N4: TMenuItem;
  27.     ViewPictureofPart1: TMenuItem;
  28.     N5: TMenuItem;
  29.     CodePrintSample1: TMenuItem;
  30.     ReportPreviewActive1: TMenuItem;
  31.     procedure Exit1Click(Sender: TObject);
  32.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  33.     procedure FormCreate(Sender: TObject);
  34.     procedure Cascade1Click(Sender: TObject);
  35.     procedure Tile1Click(Sender: TObject);
  36.     procedure Normal1Click(Sender: TObject);
  37.     procedure SelectPrinter1Click(Sender: TObject);
  38.     procedure PlainText1Click(Sender: TObject);
  39.     procedure PreviewJobCost1Click(Sender: TObject);
  40.     procedure PreviewJobDueShip1Click(Sender: TObject);
  41.     procedure ViewBluePrint1Click(Sender: TObject);
  42.     procedure PrintBluePrint1Click(Sender: TObject);
  43.     procedure ViewPictureofPart1Click(Sender: TObject);
  44.     procedure CodePrintSample1Click(Sender: TObject);
  45.     procedure ReportPreviewActive1Click(Sender: TObject);
  46.   private
  47.     { Private declarations }
  48.   public
  49.     { Public declarations }
  50.         procedure SetPreview;
  51.   end;
  52.  
  53. var
  54.   mainwin: Tmainwin;
  55.  
  56. implementation
  57.  
  58. {$R *.DFM}
  59.  
  60. procedure Tmainwin.Exit1Click(Sender: TObject);
  61. begin
  62.   close;
  63. end;
  64.  
  65. procedure Tmainwin.FormClose(Sender: TObject; var Action: TCloseAction);
  66. begin
  67.   StopLinePrinter;
  68.   StopMisc;
  69. end;
  70.  
  71. procedure Tmainwin.FormCreate(Sender: TObject);
  72. begin
  73.   WindowState:=wsNormal;
  74.   top:=0;
  75.   width:=640;
  76.   height:=480;
  77.   left:=(screen.width-width) div 2;
  78.   StartMisc;
  79.   StartLinePrinter;
  80.   SetPreview;
  81. end;
  82.  
  83. procedure Tmainwin.Cascade1Click(Sender: TObject);
  84. begin
  85.   self.cascade;
  86. end;
  87.  
  88. procedure Tmainwin.Tile1Click(Sender: TObject);
  89. begin
  90.   self.tile;
  91. end;
  92.  
  93. procedure Tmainwin.Normal1Click(Sender: TObject);
  94. var ii:integer;
  95. begin
  96.   WindowState:=wsNormal;
  97.   top:=0;
  98.   left:=0;
  99.   width:=640;
  100.   height:=480;
  101. end;
  102.  
  103. procedure Tmainwin.SelectPrinter1Click(Sender: TObject);
  104. begin
  105.   newprinter:=tnewprinter.create(self);
  106.   newprinter.show;
  107. end;
  108.  
  109. procedure Tmainwin.PlainText1Click(Sender: TObject);
  110. var tpr:TPreview;
  111. begin
  112.   tpr:=TPreview.create(self);
  113.     tpr.PrintCommandFile('load::demorout.txt');
  114. end;
  115.  
  116. procedure Tmainwin.PreviewJobCost1Click(Sender: TObject);
  117. var tpr:TPreview;
  118. begin
  119.   tpr:=TPreview.create(self);
  120.     tpr.PrintCommandFile('load::demojob.txt');
  121. end;
  122.  
  123. procedure Tmainwin.PreviewJobDueShip1Click(Sender: TObject);
  124. var tpr:TPreview;
  125. begin
  126.   tpr:=TPreview.create(self);
  127.     tpr.PrintCommandFile('load::demoinfo.txt');
  128. end;
  129.  
  130. procedure Tmainwin.ViewBluePrint1Click(Sender: TObject);
  131. var tpr:tpreview;
  132. begin
  133.   tpr:=tpreview.create(self);
  134.   tpr.windowstate:=wsNormal;
  135.   tpr.ShowBluePrint('P/N 12345-67 ','demobps.bmp','demobp.bmp');
  136. end;
  137.  
  138. procedure Tmainwin.PrintBluePrint1Click(Sender: TObject);
  139. var tpr:tpreview;
  140. begin
  141.   tpr:=tpreview.create(self);
  142.   tpr.caption:='Print B/P 12345-67';
  143.   tpr.windowstate:=wsMinimized;
  144.   tpr.PrintBluePrint('demobp.bmp');
  145. end;
  146.  
  147. procedure Tmainwin.ViewPictureofPart1Click(Sender: TObject);
  148. var lpp:lpr;
  149. begin
  150.   lpp:=lpr.create;
  151.   with lpp do begin
  152.        SetDestination;
  153.       ForceToScreen;
  154.       StartDoc(for8x11,'TEST PHOTO');
  155.       cmImage(true,2,2,'demopic.bmp','');
  156.       cmText(5,5.5,'12b','Photo Of P/N 12345-67');
  157.       StopDoc;
  158.   end;
  159.   lpp.free;
  160. end;
  161.  
  162. procedure Tmainwin.CodePrintSample1Click(Sender: TObject);
  163. var lpp:lpr;
  164.     ii:integer;
  165. begin
  166.   lpp:=lpr.create;
  167.   with Lpp do begin
  168.       SetDestination;
  169.       StartDoc(for8x11,'Test Routines');
  170.     cmText(3,1,'6:24','Text Sample Arial 24 pt');
  171.     cmText(1,2.3,'30','Text Sample Arial Bold 30 pt');
  172.     cmBox(0,4,10,1,0);
  173.     cmBox(1,5.2,0.2,12,0);
  174.     { must force font change when changing style from Raster to Text }
  175.     TextFont('12');
  176.     cmText(2,6,'b','Text Sample Bold');
  177.     cmText(2,7,'bi','Text Sample Bold Italic');
  178.     cmText(3,8,'biu','Text Sample Bold Italic Underline');
  179.     Eject;
  180.       for ii:=1 to 10 do writeln(inttostr(ii));
  181.     write('one ');
  182.     write('two ');
  183.     write('three');
  184.     writeln('');
  185.          StopDoc;
  186.   end;
  187.   lpp.free;
  188. end;
  189.  
  190. procedure TMainWin.SetPreview;
  191. begin
  192.      ReportpreviewActive1.checked:=lp.WantsPreview;
  193.   ReportpreviewActive1.caption:='Preview: '+lp.CurrentPrinterInfo;
  194. end;
  195.  
  196. procedure Tmainwin.ReportPreviewActive1Click(Sender: TObject);
  197. begin
  198.  ReportpreviewActive1.checked:=not ReportPreviewActive1.checked;
  199.  lp.WantsPreview:=ReportpreviewActive1.checked;
  200. end;
  201.  
  202. end.
  203.